unit CPGraph;

interface

uses CPBase, CPView, Graphics, Contnrs, Classes, CPPlotCanvas;



type
  { Pointer to plotter function. This function defines the shape of
    the graph.
    @param X The function argument in coordinate units
    @return The function result for the specified function argument X. }
  TCPPlotFunction = function(X: TCPFloat) : TCPFloat of object;

  TCPGraph = class;
  TCPGraphList = class;
  TCPColorPalette = class;

  { Class that iterates through the visible points of a function graph
    using a certain step size. Internal caching is used to acclerate
    successive iterations. }
  TCPGraphIterator = class
  private
    { Referenced function graph }
    FGraph: TCPGraph;
    { Left border of visible interval of the function graph in coordinate
      units }
    FLeftCoordX: TCPFloat;
    { Right border of visible interval of the function graph in coordinate
      units }
    FRightCoordX: TCPFloat;
    { Left border of visible interval of the function graph in canvas
      units }
    FLeftCanvasX: TCPFloat;
    { Right border of visible interval of the function graph in canvas
      units }
    FRightCanvasX: TCPFloat;
    { Step size between neighbored graph points in coordinate units.
      This value is derived from FCanvasStepSize. }
    FCoordStepSize: Double;
    { Step size between neighbored graph points in canvas units }
    FCanvasUnitStepSize: Double;
    { Step size between neighbored graph points in pt }
    FGraphStepSize: Double;
    { Number of visible graph points. This values depends on the left and right
      visible view range, as well as the step size. }
    FPointCount: Integer;
    { Cache containing the Y-coordinates of all visible graph points in
      canvas units. }
    FPointCache: TCPFloatArray;
    { True, if the cache does not contain valid values. This flag is only
      used, when caching is enabled. }
    FUpdateCache: Boolean;
    procedure SetGraphStepSize(const Value: Double);
    { Sets left and right visible interval of the function graph. Using left
      and right visible interval as well as FCanvasStepSize the number of graph
      points that is iterated through is also set. }
    procedure UpdateCacheSize;
    { Refills the cache with up-to-date function values. }
    procedure UpdateCache;
  public
    { Creates a new iterator instance.
      @param View Referenced view of plotter control
      @param Graph Graph that is iterated through
      @param CanvasStepSize Step size between iterated graph points in
        canvas units. }
    constructor Create(View: TCPView; Graph: TCPGraph);
    destructor Destroy; override;
    { Returns the Y-coodinate of the graph point, whose X-coordinate is closest
      to the given X-coordinate in canvas units.
      @return Y-coordinate of next graph point in canvas units }
    function GetGraphPoint(CanvasX: TCPFloat): TCPFloat;
    { Marks internal cache as outdated, so it will be refreshed when the graph
      is iterated through the next time }
    procedure InvalidateCache;
    { Attempts to draw the graph shape using the cache. }
    procedure DrawLineSegments;
    property GraphStepSize: Double read FGraphStepSize
      write SetGraphStepSize;
  end;

  { Function graph that is plotted by a plotter control }
  TCPGraph = class
  private
    { Parent graph list }
    FGraphList: TCPGraphList;
    { Referenced plotter view }
    FView: TCPView;
    { Referenced plotter canvas }
    FPlotCanvas: TCPPlotCanvas;
    { Function graph caption }
    FCaption: string;
    { Function graph iterator }
    FGraphIterator: TCPGraphIterator;
    { Pointer to the function that is plotted }
    FPlotFunction: TCPPlotFunction;
    { Fixed index, which identifies this graph instance in the parent graph
      list. This value is given by the parent graph list when the graph is
      created and added to the graph list and stay constant for the life
      time of thsi graph instance. }
    FFixedIndex: Integer;
    { Color of function graph }
    FColor: TColor;
    { Left border of the interval, in which graphs are visible.
      If set to -Inf, the interval will have no bound to the left direction. }
    FIntervalLeft: TCPFloat;
    { Right border of the interval, in which graphs are visible.
      If set to +Inf, the interval will have no bound to the right direction. }
    FIntervalRight: TCPFloat;
    { True, if graph is visible in plotter control }
    FVisible: Boolean;
    procedure SetCaption(const Value: string);
    { Draws a single graph segment. This method is called by the
      graph iterator. }
    procedure SetVisible(const Value: Boolean);
    { Retrieves color from color palette of graph list. }
    procedure UpdateColor;
  protected
    { Creates a copy of the specified graph
      @param GraphList Parent graph list
      @param Graph Graph, which is to be copied }
    constructor Create(GraphList: TCPGraphList; Graph: TCPGraph); overload;
    { Sets or gets the view }
    property View: TCPView read FView write FView;
  public
    { Creates a new function graph.
      @param GraphList Parent graph list
      @param FixedIndex Fixed index identifying this graph
      @param Caption Graph caption
      @param PlotFunction Pointer to function that is plotted }
    constructor Create(GraphList: TCPGraphList; FixedIndex: Integer;
      Caption: string; PlotFunction: TCPPlotFunction); overload;
    { Draws graph on the plot canvas using the current view. }
    procedure Draw(PlotCanvas: TCPPlotCanvas);
    { Marks the graph shape as invalid. This results in a  rebuild of the
      internal graph point cache with the next drawing call. }
    procedure InvalidateGraphShape;
    { Checks if the shape of the function graph is located near the specified
      point.
      @param Point in canvas units
      @return The function returns true, if the distance between the
        function graph and the specified point is smaller than a certain
        amount of canvas units. }
    function IsPointNear(Position: TCPPoint) : Boolean;
    { Limits drawing of this graph to the specified interval.
      @param Left Left border of the interval, in which graphs are visible.
        If set to -Inf, the interval will have no bound to the left direction.
      @param Right Right border of the interval, in which graphs are visible.
        If set to +Inf, the interval will have no bound to the right
        direction. }
    procedure SetInterval(Left: TCPFloat; Right: TCPFloat);
    { Textual description of the function graph }
    property Caption: string read FCaption write SetCaption;
    { Color of the function graph }
    property Color: TColor read FColor;
    { Fixed and unique index, which identifies this graph instance in the
      parent graph list. }
    property FixedIndex: Integer read FFixedIndex;
    { Default left border of the interval, in which graphs are visible.
      If set to -Inf, the interval will have no bound to the left direction. }
    property IntervalLeft: TCPFloat read FIntervalLeft;
    { Default right border of the interval, in which graphs are visible.
      If set to Inf, the interval will have no bound to the right direction. }
    property IntervalRight: TCPFloat read FIntervalRight;
    { Visibility state of function graph.
      If set to true, the function graph is visible; otherwise if false,
      the function graph is not drawn. }
    property Visible: Boolean read FVisible write SetVisible;
    { Function that is being plotted }
    property PlotFunction: TCPPlotFunction read FPlotFunction;
  end;

  TCPGraphList = class(TObjectList)
  private
    { Referenced plotter view }
    FView: TCPView;
    { Plotting precision of function graphs. Function graphs are plotted by
      drawing a number of connected line segments.
      This parameter defines the horizontal width between line segment in
      pt between each graph point. Lower values will result in a higher
      plotting precision. }
    FGraphStepSize: TCPFloat;
    { Provides a series of unique colors. }
    FColorPalette: TCPColorPalette;
     { If enabled, graphs will be drawn with a step size of 8 canvas units }
    FFastPreview: Boolean;
    { Default left border of the interval, in which graphs are visible.
      If set to -Inf, the interval will have no bound to the left direction. }
    FDefaultIntervalLeft: TCPFloat;
    { Default right border of the interval, in which graphs are visible.
      If set to -Inf, the interval will have no bound to the right direction. }
    FDefaultIntervalRight: TCPFloat;
    { Returns the smallest possible fixed index value, which is not in use
      by existing function graphs. }
    function CreateFixedIndex: Integer;
    function GetGraphs(Index: Integer): TCPGraph;
    procedure SetGraphs(Index: Integer; const Value: TCPGraph);
    procedure SetFastPreview(const Value: Boolean);
    procedure SetView(const Value: TCPView);
  protected
    { Is called, when a graph or the graph order in the list is changed }
    procedure GraphListChanged; virtual;
  public
    { Creates a new graph list.
      @param View Referenced plotter view }
    constructor Create(View: TCPView);
    { Copies all graphs from another graph list to this instance. }
    procedure AssignGraphs(AGraphs: TCPGraphList);
    { Tests if a function graph in the coordinate system lies near the
      specified point. A function graph is considered "near", when the distance
      is smaller than a specified value in canvas units.
      @seealso TCPGraph.IsPointNear
      @param Position Point in canvas units.
      @return(The nearest function graph or nil, when there is no function
              within the radius of the specified point.) }
    function GetGraphNearPoint(Position: TCPPoint): TCPGraph;
    { Adds a new graph to the graph list.
      @param Caption Caption of graph
      @param PlotFunction Pointer to function that is plotted }
    function Add(Caption: string; PlotFunction: TCPPlotFunction): TCPGraph;
    { Draws all graphs into the coordinate system }
    procedure Draw;
    { Marks the shape of each graph as invalid. This results in a
      rebuild of the internal graph point cache with the next drawing call. }
    procedure InvalidateGraphShapes;
    { Updates color palette on style changes of the plotter control }
    procedure PlotStyleUpdated(const PlotStyle: TCPPlotStyle);
    { Assigns to all graphs the default interval settings }
    procedure AssignDefaultInterval;
    { Function graphs of the graph list }
    property Graphs[Index: Integer]: TCPGraph read GetGraphs
      write SetGraphs; default;
    { Color palette that assings each graph a unique color }
    property ColorPalette: TCPColorPalette read FColorPalette;
    { If enabled, graphs will be drawn with a step size of 8 canvas units }
    property FastPreview: Boolean read FFastPreview write SetFastPreview;
    { Sets or gets the view }
    property View: TCPView read FView write SetView;
   { Sets or gets the default left border of the interval, in which graphs are
     visible. If set to -Inf, the interval will have no bound to the left
     direction. }
     property DefaultIntervalLeft: TCPFloat read FDefaultIntervalLeft
      write FDefaultIntervalLeft;
   { Sets or gets the default right border of the interval, in which graphs are
     visible. If set to -Inf, the interval will have no bound to the right
     direction. }
    property DefaultIntervalRight: TCPFloat read FDefaultIntervalRight
      write FDefaultIntervalRight;
  end;

  { Color palette that provides a theoretically infinite long series of unique
    colors. The color palette is optimized to provide colors that visually
    differ from each other especially for low indexes. Also the returned colors
    visually distinguish from a specified background color. }
  TCPColorPalette = class
  private
    { Background color }
    FBackColor: TColor;
    { Intensity of background color }
    FBackIntensity: Single;
    { Weights of segments in hue spectrum }
    FHueWeights: array[0..5] of Single;
    { Summed weights of segments in hue spectrum }
    FSummedHueWeights: array[0..5] of Single;
    { Converts a color specified by hue, saturation and lightness values
      to a TColor value. The color regions of the hue parameter are influenced
      by linear weights specified with SetHueWeights.
      @param H Hue, value between 0 and 360
      @param S Saturation, value between 0 and 1
      @param L Lightness, value between 0 and 1 }
    function HSLToColor(H, S, L: Single): TColor;
    { Retrieves the intensity of a color. }
    function GetIntensity(Color: TColor): Single;
    { Set background color }
    procedure SetBackColor(const Value: TColor);
    { Normalizes the hue weights. }
    procedure UpdateHueWeights;
    { Retrieves unique values from the hue spectrum by binary subdivision
      depending on Index. The notion behind this is to create a series of
      unique color hues with descending contrast. }
    function SubdivideHue(Index: Integer) : Single;
    function HueToRGB(N1, N2, H: Single): Single;
  public
    constructor Create;
    { Retrieves for the specified index a color from the palette. }
    function GetColor(Index: Integer): TColor;
    { Sets a new weighting of hues By default the color palette is set to
      produce more colors between red and yellow, as well as cyan and blue.
      This is because, human perception can identify more half tones between
      these color hues.
      @param HueWeights Weights for different segments of the color hue
        spectrum. The specified array needs to have 6 elements. Each element
        specifies the weight for one segment of the hue spectrum: The first
        element specifies weighting from Red to Yellow, the second from Yellow
        to Green, the third from Green to Cyan, the forth from Cyan to Blue,
        the fifth from Blue to Magenta and the sixth from Magenta to Red.
        The weights can be any number greater than or equal to zero, however
        at least one element needs to be greater than zero. }
    procedure SetHueWeights(HueWeights: array of Single);
    { Sets background color. This will affect the colors in the palette.
      For bright background colors the color palette is darkended, however
      hue and saturation of the palette colors will not change. }
    property BackColor: TColor read FBackColor write SetBackColor;
  end;

implementation

uses Math, Types, SysUtils;


{ TCPGraphIterator }

constructor TCPGraphIterator.Create(View: TCPView; Graph: TCPGraph);
begin
  FGraph := Graph;
  FGraphStepSize := Graph.FGraphList.FGraphStepSize;
  FCanvasUnitStepSize := 0;
  FPointCache := nil;
  InvalidateCache;
end;

procedure TCPGraphIterator.UpdateCacheSize;
var
  ViewRect: TCPRect;
  View: TCPView;
begin
  View := FGraph.FView;
  // Get coordinates of left and right view corner:
  ViewRect := FGraph.FView.ViewRect;
  FLeftCoordX := ViewRect.Left;
  FRightCoordX := ViewRect.Right;
  // Check for graph interval
  if (not IsInfinite(FGraph.FIntervalLeft)) then
    FLeftCoordX := Max(FGraph.FIntervalLeft, FLeftCoordX);
  if (not IsInfinite(FGraph.FIntervalRight)) then
    FRightCoordX := Min(FGraph.FIntervalRight, FRightCoordX);
  FLeftCanvasX := View.ToCanvas(CPToVector(FLeftCoordX, 0.0)).X;
  FRightCanvasX := View.ToCanvas(CPToVector(FRightCoordX, 0.0)).X;
  FCanvasUnitStepSize := View.PlotCanvas.PtToUnits(FGraphStepSize);
  FCoordStepSize := View.VectorToCoord(CPToVector(
    FCanvasUnitStepSize, 0.0)).X;
  // Rounding point count incremented by one avoids unstable values
  //  while panning the view:
  FPointCount := Round((FRightCanvasX - FLeftCanvasX) /
    FCanvasUnitStepSize) + 1;
  // Point count can be smaller than 0, if the interval is not in the view:
  if (FPointCount < 0) then
    FPointCount := 0;
end;

procedure TCPGraphIterator.UpdateCache;
var
  CanvasPt, CoordPt: TCPPoint;
  Index: Integer;
begin
  if (not FUpdateCache) then
    exit; // No update needed
  CanvasPt.X := FLeftCanvasX;
  CoordPt.X := FLeftCoordX;
  Index := 0;
  // Check cache status:
  if (FUpdateCache) and (FPointCount <> Length(FPointCache)) then
    SetLength(FPointCache, FPointCount);
  CPToggleFloatOpExceptions(false);
  while (Index < Length(FPointCache)) do
  begin
    CoordPt.Y := FGraph.FPlotFunction(CoordPt.X);
    CanvasPt.Y :=  FGraph.FView.ToCanvas(CoordPt).Y;
    // Fill chache:
    FPointCache[Index] := CanvasPt.Y;
    Inc(Index);
    // Move to next graph point:
    CoordPt.X := CoordPt.X + FCoordStepSize;
    CanvasPt.X := CanvasPt.X + FCanvasUnitStepSize;
  end;
  FUpdateCache := false;
  CPToggleFloatOpExceptions(true);
end;

procedure TCPGraphIterator.InvalidateCache;
begin
  FUpdateCache := true; // Mark chache as invalid
  UpdateCacheSize;
end;

destructor TCPGraphIterator.Destroy;
begin
  Finalize(FPointCache);
  inherited;
end;

function TCPGraphIterator.GetGraphPoint(CanvasX: TCPFloat): TCPFloat;
var
  Index: Integer;
  Y: TCPFloat;
begin
//  UnRound(FPointCount - 1) := (FRightCanvasX - FLeftCanvasX) / FCanvasStepSize;
  if (not FUpdateCache) and
    (CanvasX <= FRightCanvasX) and (CanvasX >= FLeftCanvasX) then
  begin
    Index := Round((CanvasX - FLeftCanvasX) / FCanvasUnitStepSize);
    Result := FPointCache[Index];
  end
  else
  begin
    Y := FGraph.FPlotFunction(FGraph.FView.ToCoord(
      CPToVector(CanvasX, 0.0)).X);
    Result := FGraph.FView.ToCanvas(CPToVector(0.0, Y)).Y;
  end;
end;

procedure TCPGraphIterator.DrawLineSegments;
begin
  UpdateCache;
  FGraph.FView.PlotCanvas.DrawLineSegments(FPointCache, FLeftCanvasX,
    FRightCanvasX, FCanvasUnitStepSize);
end;


procedure TCPGraphIterator.SetGraphStepSize(const Value: Double);
begin
  if (Value <> FGraphStepSize) then
  begin
    FGraphStepSize := Value;
    InvalidateCache;
  end;
end;

{ TCPGraph }

constructor TCPGraph.Create(GraphList: TCPGraphList; FixedIndex: Integer;
  Caption: string; PlotFunction: TCPPlotFunction);
begin
  FGraphList := GraphList;
  FView := GraphList.FView;
  FPlotFunction := PlotFunction;
  FCaption := Caption;
  FFixedIndex := FixedIndex;
  UpdateColor;
  FVisible := true;
  FIntervalLeft := FGraphList.FDefaultIntervalLeft;
  FIntervalRight := FGraphList.FDefaultIntervalRight;
  FGraphIterator := TCPGraphIterator.Create(FView, self);
end;

constructor TCPGraph.Create(GraphList: TCPGraphList; Graph: TCPGraph);
begin
  FGraphList := GraphList;
  FView := GraphList.FView;
  FPlotFunction := Graph.FPlotFunction;
  FCaption := Graph.FCaption;
  FFixedIndex := Graph.FFixedIndex;
  FColor := Graph.Color;
  FVisible := Graph.FVisible;
  FIntervalLeft := Graph.FIntervalLeft;
  FIntervalRight := Graph.FIntervalRight;
  FGraphIterator := TCPGraphIterator.Create(FView, self);
end;

procedure TCPGraph.Draw(PlotCanvas: TCPPlotCanvas);
begin
  FPlotCanvas := PlotCanvas;
  FPlotCanvas.PenColor := FColor;
  FGraphIterator.DrawLineSegments;
end;

procedure TCPGraph.InvalidateGraphShape;
begin
  FGraphIterator.InvalidateCache;
end;

function TCPGraph.IsPointNear(Position: TCPPoint): Boolean;
const
  NearThreshold = 3; // Search threshold in canvas units
var
  X, EndX, Y, OldX, OldY: TCPFloat;
  Rect: TCPRect;
  CanvasUnitStep: Double;
begin
  // A hidden graph will return false:
  if (not FVisible) then
  begin
    Result := false;
    exit;
  end;
  CPToggleFloatOpExceptions(false);
  CanvasUnitStep := FView.PlotCanvas.PtToUnits(FGraphList.FGraphStepSize);
  X := Position.X - NearThreshold - CanvasUnitStep;
  Y := FGraphIterator.GetGraphPoint(X);
  EndX := Position.X + NearThreshold;
  if (not IsInfinite(FIntervalLeft)) then
    X := Max(X, FView.ToCanvas(CPToVector(FIntervalLeft, 0.0)).X);
  if (not IsInfinite(FIntervalRight)) then
    EndX := Min(EndX, FView.ToCanvas(CPToVector(FIntervalRight, 0.0)).X);
  while (X <= EndX) do
  begin
    OldX := X;
    X := X + CanvasUnitStep;
    OldY := Y;
    Y := FGraphIterator.GetGraphPoint(X);
    // Create bounding box for fast hit test:
    Rect := CPToRect(OldX - NearThreshold, OldY, X + NearThreshold, Y);
    if (Rect.Top > Rect.Bottom) then
      CPSwap(Rect.Top, Rect.Bottom);
    Rect.Top := Rect.Top - NearThreshold;
    Rect.Bottom := Rect.Bottom + NearThreshold;
    // Hit test passes, if point lies in the bounding box of the line segment:
    if (CPPtInRect(Rect, Position)) then
    begin
      Result := true;
      exit;
    end;
  end;
  Result := false;
  CPToggleFloatOpExceptions(true);
end;

procedure TCPGraph.SetCaption(const Value: string);
begin
  if (Value <> FCaption) then
  begin
    FCaption := Value;
  end;
end;

procedure TCPGraph.SetInterval(Left,
  Right: TCPFloat);
begin
  FIntervalLeft := Left;
  FIntervalRight := Right;
  InvalidateGraphShape;
  FGraphList.GraphListChanged;
end;

procedure TCPGraph.SetVisible(const Value: Boolean);
begin
  if (Value <> FVisible) then
  begin
    FVisible := Value;
    FGraphList.GraphListChanged;
  end;
end;

procedure TCPGraph.UpdateColor;
begin
  FColor := FGraphList.FColorPalette.GetColor(FFixedIndex);
end;

{ TCPGraphList }

function TCPGraphList.Add(Caption: string;
  PlotFunction: TCPPlotFunction): TCPGraph;
begin
  Result := TCPGraph.Create(self, CreateFixedIndex, Caption, PlotFunction);
  inherited Add(Result);
  GraphListChanged;
end;

constructor TCPGraphList.Create(View: TCPView);
begin
  inherited Create(true);
  FView := View;
  FGraphStepSize := 1; // 1 graph point per pixel for on screen display
  FColorPalette := TCPColorPalette.Create;
  FDefaultIntervalLeft := NegInfinity;
  FDefaultIntervalRight := Infinity;
end;

function TCPGraphList.CreateFixedIndex: Integer;
var
  I, Index: Integer;
  IDs: array of Boolean;
begin
  SetLength(IDs, Count);
  for I := Low(IDs) to High(IDs) do
    IDs[I] := true;
  for I := 0 to Count - 1 do
  begin
    Index := TCPGraph(Items[I]).FFixedIndex;
    if (Index <= Count) then
      IDs[Index] := false;
  end;
  Result := Count;
  for I := Low(IDs) to High(IDs) do
    if (IDs[I]) then
    begin
      Result := I;
      break;
    end;
  Finalize(IDs);
end;

procedure TCPGraphList.Draw;
var
  I: Integer;
  Graph: TCPGraph;
  PlotCanvas: TCPPlotCanvas;
begin
  PlotCanvas := FView.PlotCanvas;
  for I := 0 to Count - 1 do
  begin
    Graph := Graphs[I];
    if Graph.Visible then
      Graph.Draw(PlotCanvas);
  end;
end;

function TCPGraphList.GetGraphNearPoint(Position: TCPPoint): TCPGraph;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if (TCPGraph(Items[I]).IsPointNear(Position)) then
    begin
      Result := TCPGraph(Items[I]);
      exit;
    end;
  Result := nil
end;

function TCPGraphList.GetGraphs(Index: Integer): TCPGraph;
begin
  Result := TCPGraph(Items[Index]);
end;

procedure TCPGraphList.GraphListChanged;
begin
  { Do nothing }
end;

procedure TCPGraphList.InvalidateGraphShapes;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TCPGraph(Items[I]).InvalidateGraphShape;
end;

procedure TCPGraphList.PlotStyleUpdated(const PlotStyle: TCPPlotStyle);
var
  I: Integer;
begin
  FColorPalette.BackColor := PlotStyle.Colors.Background;
  FGraphStepSize := PlotStyle.GraphStepSize;
  for I := 0 to Count - 1 do
  begin
    Graphs[I].UpdateColor;
    Graphs[I].FGraphIterator.GraphStepSize := FGraphStepSize;
  end;
  GraphListChanged;
end;


procedure TCPGraphList.SetGraphs(Index: Integer; const Value: TCPGraph);
begin
  Items[Index] := Value;
end;

procedure TCPGraphList.SetFastPreview(const Value: Boolean);
var
  I: Integer;
  AGraphStepSize: Double;
begin
  if (Value <> FFastPreview) then
  begin
    FFastPreview := Value;
    if (FFastPreview) then
      AGraphStepSize := 16
    else
      AGraphStepSize := FGraphStepSize;
    for I := 0 to Count - 1 do
      Graphs[I].FGraphIterator.GraphStepSize := AGraphStepSize;
  end;
end;

procedure TCPGraphList.SetView(const Value: TCPView);
var
  I: Integer;
begin
  if (FView <> Value) then
  begin
    FView := Value;
    for I := 0 to Count - 1 do
      Graphs[I].View := Value;
  end;
end;

procedure TCPGraphList.AssignGraphs(AGraphs: TCPGraphList);
var
  I: Integer;
begin
  Clear;
  for I := 0 to AGraphs.Count - 1 do
    inherited Add(TCPGraph.Create(self,  Agraphs.Graphs[I]));
  GraphListChanged;
end;

procedure TCPGraphList.AssignDefaultInterval;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Graphs[I].SetInterval(FDefaultIntervalLeft, FDefaultIntervalRight);
end;

{ TCPColorPalette }

function TCPColorPalette.GetColor(Index: Integer): TColor;
const
  HueSteps = 12;
  LightnessSteps = 2;
var
  H, L: Single;
  IntensityDelta: Single;
begin
  // Retrieve full bright color with unique hue value:
  H := SubdivideHue(Index);
  Result := HSLToColor(H, 1.0, 0.5);
  // Darken colors a bit for light backgrounds:
  IntensityDelta := GetIntensity(Result) - FBackIntensity;
  if (Abs(IntensityDelta) > 0.2) then
    L := 0.5
  else
    if (FBackIntensity < 0.5) then // Color slightly darker than background
      L := 0.6
    else // Color slightly lighter than background
      L := 0.4;
  Result := HSLToColor(H, 1.0, L);
end;

function TCPColorPalette.HueToRGB(N1, N2, H: Single) : Single;
begin
  H := Frac(H / 6.0 + 1.0) * 6.0; // = FMod(H, 6)
  if (H < 1.0) then
    Result := N1 + ((N2 - N1) * H)
  else if (H < 3.0) then
    Result := N2
  else if (H < 4.0) then
    Result := N1 + ((N2 - N1) * (4.0 - H))
  else
    Result := N1;
end;

constructor TCPColorPalette.Create;
begin
  BackColor := clBlack;
  FHueWeights[0] := 100;
  FHueWeights[1] := 50;
  FHueWeights[2] := 10;
  FHueWeights[3] := 100;
  FHueWeights[4] := 61;
  FHueWeights[5] := 62;
  UpdateHueWeights;
end;

function TCPColorPalette.GetIntensity(Color: TColor): Single;
var
  R, G, B: Byte;
begin
  R := Color and $FF;
  G := (Color shr 8) and $FF;
  B := (Color shr 8) and $FF;
  // Color weighting like ITU-R Recommendation BT.709:
  Result := R / 255 * 0.2125 + G / 255 * 0.7154 + B / 255 * 0.0721;
end;

function TCPColorPalette.HSLToColor(H, S, L: Single): TColor;
var
  R, G, B: Byte;
  N1, N2, T: Single;
  I: Integer;
begin
  if (S = 0) then
  begin
    R := Round(L * 255);
    Result := R or (R shl 8) or (R shl 16); // Achromatic (gray)
    exit;
  end;
  if (L < 0.5) then
    N2 := L * (1.0 + S)
  else
    N2 := L + S - L * S;
  N1 := (2.0 * L) - N2;
  H := H / 60.0;
{
0.0 2.1456
2.1456 0.6378
2.7834 0.2166
3.0 2.1456
5.1456 0.6378
5.7834 0.2166
}
  for I := Low(FHueWeights) to High(FHueWeights) do
    if (H < FSummedHueWeights[I]) then
    begin
      if (I = 0) then
        T := 0
      else
        T := FSummedHueWeights[I - 1];
      H := (H - T) / FHueWeights[I] + I;
      break;
    end;

{  if (H < 2.1456) then // R-Y
    H := H / 2.1456
  else if (H < 2.7834) then // Y-G
    H := (H - 2.1456) / 0.6378 + 1.0
  else if (H < 3.0) then // G-C
    H := (H - 2.7834) / 0.2166 + 2.0
  else if (H < 5.1456) then // C-B
    H := (H - 3.0) / 2.1456 + 3.0
  else if (H < 5.7834) then // B-M
    H := (H - 5.1456) / 0.6378 + 4.0
  else
    H := (H - 5.7834) / 0.2166 + 5.0;}

  R := Round(HueToRGB(N1, N2, H + 2.0) * 255);
  G := Round(HueToRGB(N1, N2, H      ) * 255);
  B := Round(HueToRGB(N1, N2, H - 2.0) * 255);
  Result := R or (G shl 8) or (B shl 16);
end;

procedure TCPColorPalette.SetBackColor(const Value: TColor);
begin
  if (ColorToRGB(Value) <> FBackColor) then
  begin
    FBackColor := ColorToRGB(Value);
    FBackIntensity := GetIntensity(FBackColor);
  end;
end;

function TCPColorPalette.SubdivideHue(Index: Integer): Single;
var
  C, B: Single;
begin
  C := LogN(2, Index + 0.5);
  B := Frac(Power(2, Frac(C)) - 1);
  Result := B * 360;
end;

procedure TCPColorPalette.UpdateHueWeights;
var
  Sum: Single;
  I: Integer;
begin
  Sum := 0;
  for I := Low(FHueWeights) to High(FHueWeights) do
    Sum := Sum + FHueWeights[I];
  Sum := 6 / Sum;

  for I := Low(FHueWeights) to High(FHueWeights) do
  begin
    FHueWeights[I] := FHueWeights[I] * Sum;
    if (I = 0) then
      FSummedHueWeights[I] := FHueWeights[I]
    else
      FSummedHueWeights[I] := FSummedHueWeights[I - 1] + FHueWeights[I];
  end;
end;


procedure TCPColorPalette.SetHueWeights(HueWeights: array of Single);
var
  I: Integer;
begin
  for I := Low(FHueWeights) to High(FHueWeights) do
    FHueWeights[I] := HueWeights[I];
  UpdateHueWeights;
end;

initialization
end.



